home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / Compiler.Mod (.txt) < prev    next >
Oberon Text  |  1995-05-26  |  6KB  |  187 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 26 May 95
  5. MODULE Compiler;
  6. (* Compiler for Oberon-2 on Sun-3 workstations.
  7.  Diplomarbeit Samuel Urech
  8.  Programming language: Oberon-2 on Ceres-1.
  9.  Date: 3.11.92   Current version: 
  10.  IMPORT
  11.   Texts, TextFrames, Viewers, Oberon,
  12.   OPP, OPB, OPV, OPT, OPS, OPC, OPL, OPM;
  13.  CONST
  14.   OptionChar = "\";
  15.   ShowCommand = "OPdump.Show";
  16.   SignOnMessage = "Compiler  SU 26.5.95";
  17.   (* compiler options: *)
  18.   inxchk = 0; (* index check on *)
  19.   ovflchk = 1; (* overflow check on *)
  20.   ranchk = 2; (* range check on *)
  21.   typchk = 3; (* type check on *)
  22.   newsf = 4; (* generation of new symbol file allowed *)
  23.   ptrinit = 5; (* pointer initialization *)
  24.   intprinf = 6; (* inter-procedural information about register allocation used *)
  25.   assert = 7; (* assert evaluation *)
  26.   findpc = 8; (* find text position of breakpc *)
  27.   nilchk = 9; (* NIL check *)
  28.   defopt = {inxchk, typchk, ptrinit, assert, nilchk}; (* default options *)
  29.   prog*: OPT.Node;
  30.   showTree, watch: BOOLEAN;
  31.   (* global because of the GC call on Ceres*)
  32.   source: Texts.Text;
  33.   sourceR: Texts.Reader;
  34.   S: Texts.Scanner;
  35.   v: Viewers.Viewer;
  36.   W: Texts.Writer;
  37.  PROCEDURE Module*(source: Texts.Reader; options: ARRAY OF CHAR; breakpc: LONGINT; log: Texts.Text; VAR error: BOOLEAN);
  38.   VAR key: LONGINT; opt: SET; ch: CHAR; newSF: BOOLEAN;
  39.    p: OPT.Node; modName: OPS.Name;
  40.    res, i: INTEGER;
  41.    command: ARRAY 32 OF CHAR;
  42.  BEGIN
  43.   IF watch THEN command := "System.Watch"; Oberon.Call(command, Oberon.Par, FALSE, res) END ;
  44.   opt := defopt; i := 0;
  45.   REPEAT
  46.    ch := options[i]; INC(i);
  47.    IF ch = "x" THEN opt := opt / {inxchk}
  48.    ELSIF ch = "v" THEN opt := opt / {ovflchk}
  49.    ELSIF ch = "r" THEN opt := opt / {ranchk}
  50.    ELSIF ch = "t" THEN opt := opt / {typchk}
  51.    ELSIF ch = "s" THEN opt := opt / {newsf}
  52.    ELSIF ch = "p" THEN opt := opt / {ptrinit}
  53.    ELSIF ch = "i" THEN opt := opt / {intprinf}
  54.    ELSIF ch = "a" THEN opt := opt / {assert}
  55.    ELSIF ch = "f" THEN opt := opt / {findpc}
  56.    ELSIF ch = "n" THEN opt := opt / {nilchk}
  57.    END
  58.   UNTIL ch = 0X;
  59.   OPM.Init(source, log); OPS.Init; OPT.Init; OPB.typSize := OPV.TypSize;
  60.   newSF := newsf IN opt;
  61.   OPT.OpenScope(0, NIL);
  62.   OPP.Module(p, modName);
  63.   IF OPM.noerr THEN
  64.    OPL.Init(opt);
  65.    OPV.Init(opt, breakpc);
  66.    OPV.AdrAndSize;
  67.    OPM.errpos := 0;
  68.    key := OPM.NewKey();
  69.    OPT.Export(modName, newSF, key);
  70.    IF newSF THEN OPM.LogWStr(" new symbol file") END ;
  71.    IF showTree THEN prog := p; command := ShowCommand;
  72.     Oberon.Call(command, Oberon.Par, FALSE, res); prog := NIL
  73.    END ;
  74.    IF OPM.noerr THEN
  75.     OPM.OpenRefObj(modName);
  76.     OPC.Init(opt);
  77.     OPV.Module(p);
  78.     IF OPM.noerr THEN
  79.      OPL.OutCode(modName, key);
  80.      IF OPM.noerr THEN
  81.       OPM.CloseRefObj;
  82.       OPM.LogWNum(OPL.pc, 8);
  83.       OPM.LogWNum(OPL.dsize, 8);
  84.      END;
  85.     END;
  86.    END;
  87.    OPL.Close;
  88.   END ;
  89.   OPT.CloseScope; OPT.Close;
  90.   OPM.LogWLn; error := ~OPM.noerr;
  91.   IF watch THEN command := "System.Watch"; Oberon.Call(command, Oberon.Par, FALSE, res) END
  92.  END Module;
  93.  PROCEDURE Compile*;
  94.   VAR beg, end, time, pos: LONGINT; error: BOOLEAN; ch: CHAR;
  95.   PROCEDURE Do(filename: ARRAY OF CHAR; beg: LONGINT);
  96.    VAR S1: Texts.Scanner; line, i: INTEGER; options: ARRAY 32 OF CHAR;
  97.     fbeg, fend, ftime, breakpc: LONGINT; ftext: Texts.Text; f: BOOLEAN;
  98.   BEGIN
  99.    Texts.WriteString(W, filename); Texts.WriteString(W, "  compiling  ");
  100.    Texts.OpenScanner(S1, source, beg); Texts.Scan(S1);
  101.    IF (S1.class = Texts.Name) & (S1.s = "MODULE") THEN
  102.     Texts.Scan(S1);
  103.     IF S1.class = Texts.Name THEN Texts.WriteString(W, S1.s) END
  104.    END ;
  105.    Texts.Append(Oberon.Log, W.buf);
  106.    line := S.line; pos := Texts.Pos(S); i := 0; f := FALSE;
  107.    Texts.Scan(S);
  108.    IF (S.line = line) & (S.class = Texts.Char) & (S.c = OptionChar) THEN
  109.     ch := S.nextCh;
  110.     WHILE ((ch >= "0") & (ch <= "9") OR (ch >= "a") & (ch <= "z")) & (i < LEN(options) - 1) DO
  111.      options[i] := ch; INC(i);
  112.      IF ch = "f" THEN f := ~f END ;
  113.      Texts.Read(S, ch)
  114.     END ;
  115.     S.nextCh := ch;
  116.     pos := Texts.Pos(S); Texts.Scan(S)
  117.    END ;
  118.    options[i] := 0X;
  119.    IF f THEN
  120.     LOOP
  121.      Oberon.GetSelection(ftext, fbeg, fend, ftime);
  122.      IF ftime >= 0 THEN
  123.       Texts.OpenScanner(S1, ftext, fbeg); Texts.Scan(S1);
  124.       IF S1.class = Texts.Int THEN breakpc := S1.i; EXIT END
  125.      END ;
  126.      Texts.WriteString(W, "  pc not selected"); Texts.WriteLn(W);
  127.      Texts.Append(Oberon.Log, W.buf); error := TRUE; RETURN
  128.     END
  129.    END ;
  130.    Texts.OpenReader(sourceR, source, beg);
  131.    Module(sourceR, options, breakpc, Oberon.Log, error)
  132.   END Do;
  133.  BEGIN
  134.   error := FALSE;
  135.   Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  136.   IF S.class = Texts.Char THEN
  137.    IF S.c = "*" THEN
  138.     v := Oberon.MarkedViewer();
  139.     IF (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  140.      source := v.dsc.next(TextFrames.Frame).text; Do("", 0)
  141.     END
  142.    ELSIF S.c = "^" THEN
  143.     Oberon.GetSelection(source, beg, end, time);
  144.     IF time >= 0 THEN
  145.      Texts.OpenScanner(S, source, beg); pos := Texts.Pos(S); Texts.Scan(S); NEW(source); 
  146.      WHILE (S.class = Texts.Name) & (pos < end) & ~error DO
  147.       Texts.Open(source, S.s);
  148.       IF source.len # 0 THEN Do(S.s, 0)
  149.       ELSE
  150.        Texts.WriteString(W, S.s); Texts.WriteString(W, " not found");
  151.        Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); error := TRUE
  152.       END
  153.      END
  154.     END
  155.    ELSIF S.c = "@" THEN
  156.     Oberon.GetSelection(source, beg, end, time);
  157.     IF time >= 0 THEN Do("", beg) END
  158.    END
  159.   ELSE NEW(source);
  160.    WHILE (S.class = Texts.Name) & ~error DO
  161.     Texts.Open(source, S.s);
  162.     IF source.len # 0 THEN Do(S.s, 0)
  163.     ELSE
  164.      Texts.WriteString(W, S.s); Texts.WriteString(W, " not found");
  165.      Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); error := TRUE
  166.     END
  167.    END
  168.   END ;
  169.   Oberon.Collect(0)
  170.  END Compile;
  171.  PROCEDURE ShowTree*;
  172.  BEGIN showTree := TRUE
  173.  END ShowTree;
  174.  PROCEDURE HideTree*;
  175.  BEGIN showTree := FALSE
  176.  END HideTree;
  177.  PROCEDURE DoWatch*;
  178.  BEGIN watch := TRUE
  179.  END DoWatch;
  180.  PROCEDURE DontWatch*;
  181.  BEGIN watch := FALSE
  182.  END DontWatch;
  183. BEGIN
  184.  (* HideTree; DontWatch; *) prog := NIL; Texts.OpenWriter(W);
  185.  Texts.WriteString(W, SignOnMessage); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  186. END Compiler.
  187.